perm filename EXPAND.F4[EMS,LCS] blob sn#722188 filedate 1983-08-02 generic text, type T, neo UTF8
C  EXPAND.F4  ***** LOAD WITH READRW.F4, READX.F4
      INTEGER TOTL,TOTOUT
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON /OUTL/OX(650),OY(650),OZ(650)
      COMMON /S/SL(650),P(650)
	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
	COMMON/I/ I(3000)
1	CALL DPYSET(1,I,3000)
	TOTL=0
	DDY=0
	DDX=0
	TOTOUT=0
      CALL READRW
C READ IN THE DRAWING
	IB=1
	DDX=100
	CALL DPY(X,Y,Z,TOTL)
2     CALL RDOUTL
C READ IN THE OUTLINE
	IB=1
	IF(DDY.NE.0)GO TO 6
C JUMP IF DOING DRAWING TRANSITION.
	CALL DPY(OX,OY,OZ,TOTOUT)
3     CALL MAKNEW
C EXPAND THE DRAWING
7	IB=6
C MAKE EXPANDED IMAGE BRIGHTER (IB=6)
4	CALL DPY(X,Y,Z,TOTL)
5     CALL SAVIT
      GO TO 1
6	CALL TRNSIT
	GO TO 7
      END

	SUBROUTINE MAKNEW
      INTEGER TOTL,TOTOUT,HIT
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON /OUTL/OX(650),OY(650),OZ(650)
      COMMON /S/SL(650),P(650)
	COMMON /CCC/G
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT
10	FORMAT(' CX=',F6.3,' CY=',F6.3)
11	FORMAT(' X,Y,Z = '2F8.3,F3.0)
	TYPE 10,CX,CY
CC	DO 12 K=1,TOTL
CC12	TYPE 11,X(K),Y(K),Z(K)
	K=1
1	DO 2 J=2,TOTOUT
	IF(HIT(J,OX,OY,K,A,B).LT.0)GO TO 2
C NOW RESET COORDS.
	X(K)=CX+(A-CX)*P(K)*G
 	Y(K)=CY+(B-CY)*P(K)*G
CX	X(K)=X(K)+(A-X(K))*G*P(K)
C	Y(K)=Y(K)+(B-Y(K))*G*P(K)
C P = % OF LONGEST LINE FROM CENTER TO A POINT.
CC13	TYPE 11,X(K),Y(K),Z(K)
	IF(K.EQ.TOTL)RETURN
	K=K+1
	GO TO 1
2	CONTINUE
	END

	INTEGER FUNCTION HIT(J,OX,OY,K,A,B)
	DIMENSION OX(1),OY(1)
      INTEGER TOTL,TOTOUT,HIT
      COMMON /XYZ/X(650),Y(650),Z(650)
CC    COMMON /OUTL/OX(650),OY(650)
      COMMON /S/SL(650),P(650)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT
	RX=OX(J-1)
	SX=OX(J)
	RY=OY(J-1)
	SY=OY(J)
	IF(RX.LE.SX)GO TO 2
	SX=RX
	RX=OX(J)
	SY=RY
	RY=OY(J)
2	TY=RY
	UY=SY
	IF(TY.LE.UY)GO TO 4
	UY=RY
	TY=SY
C TY=BOTTOM, UY =TOP, RX=LEFT, SX=RIGHT
4	C=SX-RX
	IF(C.EQ.0)GO TO 1
	SS=(SY-RY)/C
C SLOPE OF THIS LINE
	A=(RY-CY-SS*RX+SL(K)*CX)/(SL(K)-SS)
	B=SS*(A-RX)+RY
5	HIT=-1
C A MISS
	IF(A.LT.RX.OR.A.GT.SX)RETURN
	IF(B.LT.TY.OR.B.GT.UY)RETURN
	IF(Y(K).LT.CY.AND.CY.LT.B)RETURN
	IF(Y(K).GT.CY.AND.CY.GT.B)RETURN
	IF(X(K).LT.CX.AND.CX.LT.A)RETURN
	IF(X(K).GT.CX.AND.CX.GT.A)RETURN
	HIT=0
C A HIT 
	RETURN
1	B=SL(K)*(SX-CX)+CY
	A=RX
	GO TO 5
	END

	SUBROUTINE DPY(X,Y,Z,L)
      INTEGER TOTL,TOTOUT
	DIMENSION X(1),Y(1),Z(1)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
C MAKE EXPANDED IMAGE BRIGHTER
	CALL DPYBRT(IB)
	Q=0
	IF(IB.GT.4)Q=500
10	DO 1 K=1,L
	M=DSZ*X(K)+.5-DDX
	N=DSZ*Y(K)+.5-Q
	IF(Z(K).NE.0)GO TO 2
	CALL AVECT(M,N)
	GO TO 1
2	CALL AIVECT(M,N)
1	CONTINUE
	CALL DPYOUT(1)
	END

	SUBROUTINE SAVIT
	INTEGER TOTL
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
	COMMON/NM2/NM2
	CALL IO(3)
	IF(NM2.EQ.' ')RETURN
	DO 1 K=1,TOTL
	A=X(K)
	B=.5
	IF(A.LT.0)B=-B
	L=A+B
	A=Y(K)
	B=.5
	IF(A.LT.0)B=-B
	M=A+B
	N=Z(K)
1	WRITE(20,2)K,L,M,N
	END FILE 20
2	FORMAT(1I4,2I5,1I3)
	END

	SUBROUTINE TRNSIT
      INTEGER TOTL,TOTOUT
	COMMON /XYZ/X(650),Y(650),Z(650)
	COMMON /OUTL/OX(650),OY(650),OZ(650)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT,IB
	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
	DDX=600
	CALL DPY(OX,OY,OZ,TOTOUT)
	DO 1 K=1,TOTL
	X(K)=X(K)-(X(K)-OX(K))*CCX
1	Y(K)=Y(K)-(Y(K)-OY(K))*CCY
	DDX=350
	END